home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 050 / tpstuff2.arc / MENU.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-07-17  |  6.2 KB  |  188 lines
  1. { Menu Generator
  2.  
  3.   Author: Michael H. Hughes;  Hereby placed in the Public Domain
  4.  
  5.   This program illustrates the function "menu" which generates a very nice
  6.   kind of menu display.  This general type of menu has been common on Wang
  7.   equipment for years, but has not caught on elsewhere.  It is a neater and
  8.   quicker menu than most of the common types.
  9.  
  10.   Pass the function a list of descriptive lines, and it will display them
  11.   on the screen along with a heading and instructions.  A pointer is displayed
  12.   beside the first line of the list, and that line is highlighted.  Press
  13.   a key (usually the space-bar) and the pointer will drop one line down the
  14.   list.  Another key (backspace) will move the pointer back up the list.
  15.   Pressing any character key will cause the routine to search for a line
  16.   beginning with that character.  If found, the pointer will be positioned
  17.   on that line.  Another key (return/enter) will cause the routine to exit
  18.   and return the number of the selected line.  Another key (ESC) can be used
  19.   as a "cancel" and will return a zero.
  20.  
  21.   Up to 40 items can be displayed.  The routine will position them
  22.   automatically, using two columns if necessary.
  23.  
  24.   The routine requires a single-keystroke input routine which does not echo
  25.   to the screen or require a return/enter to respond.  A function suitable
  26.   for MSDOS/PCDOS machines is supplied.
  27.  
  28.   The display will look better if you insert the necessary code to turn the
  29.   cursor off.
  30.  
  31.   Note the use of a typeless parameter and an absolute address to pass an
  32.   array of uknown length to the routine.   }
  33.  
  34.  
  35.  
  36.  
  37.  
  38.  
  39. Function menu(number: Integer; Var data): Integer; { Generate Menu Display }
  40.  
  41.   Const llen = 80;          { screen line length }
  42.         slen = 20;          { maximum number items in one column }
  43.         maxnumber = 40;     { maximum size of list array }
  44.  
  45.         movedownlist = 32;  { SPACE key }
  46.         moveuplist = 8;     { BACKSPACE key }
  47.         select = 13;        { ENTER/RETURN key }
  48.         cancel = 27;        { ESC key }
  49.  
  50.   Type listtype=Array[0..maxnumber] Of String[30];
  51.  
  52.   Var list: listtype Absolute data;
  53.       posn, len, margin, vmargin, maxlen: Integer;
  54.       minlen, count, cnumber: Integer;
  55.       ch: Char;
  56.       chval: Byte;
  57.  
  58.   Function keyin: Byte;   { Single-Key Input Routine (MSDOS/PCDOS) }
  59.   Var register: Record    { register pack }
  60.        AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAG: Integer;
  61.      End;
  62.  
  63.   Begin
  64.     register.AX := $0700; { call function 07 }
  65.     MsDos(register);
  66.     keyin := register.AX And $00FF;
  67.   End;
  68.  
  69.  
  70.   Begin  { Menu }
  71.     { Display Heading }
  72.     ClrScr; LowVideo;
  73.     write(chr(27),'[5h'); { ANSI cursor-off command; change as required }
  74.     writeln(list[0]);     { Title line }
  75.     For posn:=1 To llen Do write('='); writeln;
  76.  
  77.     { Compute positioning parameters }
  78.     If number > maxnumber Then number:=maxnumber;
  79.     If number <= slen Then len:=number Else len:=slen;
  80.     If number > slen Then margin:=1
  81.     Else
  82.       Begin
  83.         maxlen:=0; minlen:=80;
  84.         For count:=1 to number Do
  85.           Begin
  86.             If length(list[count]) > maxlen Then maxlen:=length(list[count]);
  87.             If length(list[count]) < minlen Then minlen:=length(list[count])
  88.           End;
  89.         margin:=34-(maxlen+minlen) Div 4
  90.       End;
  91.     If number <= slen Then vmargin:=(slen-number) Div 2
  92.     Else vmargin:=(slen-(number Div 2)) Div 2;
  93.     vmargin:=vmargin+3;
  94.     If number > slen Then
  95.       Begin
  96.         cnumber:=number Div 2;
  97.         If odd(number) Then cnumber:=cnumber+1
  98.       End
  99.     Else cnumber:=number;
  100.  
  101.     { Display list }
  102.     For posn:=1 To cnumber Do
  103.       Begin
  104.         gotoxy(margin+4,posn+vmargin);
  105.         write(list[posn]);
  106.         If ((number) > slen) And ((posn+cnumber) <= number) Then
  107.           Begin
  108.             gotoxy(45,posn+vmargin);
  109.             write(list[posn+cnumber])
  110.           End;
  111.         writeln
  112.       End;
  113.  
  114.     { Display Instructions }
  115.     gotoxy(1,24); NormVideo;
  116.     writeln('Press SPACE or BACKSPACE or First Letter of Line to Select');
  117.     write('Press RETURN or ENTER to run your choice');
  118.  
  119.     { Pick menu }
  120.     posn:=1;
  121.     Repeat
  122.       { Display current pick }
  123.       gotoxy(((posn-1) Div cnumber)*40+margin,
  124.                 ((posn-1) Mod cnumber)+1+vmargin);
  125.       NormVideo;
  126.       write(' -> ',list[posn]);
  127.       { Get Keyboard and clear current pick }
  128.       chval:=keyin;
  129.       gotoxy(((posn-1) Div cnumber)*40+margin,
  130.                 ((posn-1) Mod cnumber)+1+vmargin);
  131.       LowVideo;
  132.       If chval <> select Then write('    ',list[posn]);
  133.  
  134.       { Determine new Pick }
  135.       If chval = select Then menu:=posn
  136.       Else If chval = cancel Then menu:=0
  137.       Else If chval = moveuplist Then
  138.         If posn > 1 Then posn:=posn-1
  139.         Else posn:=number
  140.       Else If chval = movedownlist Then
  141.         If posn < (number) Then posn:=posn+1
  142.         Else posn:=1
  143.       Else   { Check for first character of line }
  144.         Begin
  145.           count:=posn;
  146.           ch:=UpCase(chr(chval));
  147.           Repeat
  148.             count:=succ(count);
  149.             If count > number Then count:=1
  150.           Until (count = posn) Or (ch = UpCase(copy(list[count],1,1)));
  151.           posn:=count
  152.         End
  153.     Until (chval = select) Or (chval = cancel)
  154.   End;
  155.  
  156.  
  157.  
  158. { The following program illustrates the use of MENU as a basic program loader.
  159.   The typed constants are used to set up the menu, and can be changed to
  160.   provide any desired choice.  The program list is simply in the same order as
  161.   the descriptive lines.  Lines[0] defines the menu heading while progs[0] is
  162.   the program to be loaded if the "cancel" key is pressed.  }
  163.  
  164.  
  165. Const maxlines = 4; { number of lines in menu }
  166.  
  167.       lines: Array[0..maxlines] Of String[30] =
  168.          ('General Business Menu',
  169.           'Accounts Receivable',
  170.           'Accounts Payable',
  171.           'Payroll',
  172.           'General Ledger');
  173.  
  174.       progs: Array[0..maxlines] Of String[30] =  { list of programs to load }
  175.          ('MAINMENU.COM',
  176.           'AR.COM',
  177.           'AP.COM',
  178.           'PA.COM',
  179.           'GL.COM');
  180.  
  181. Var nextprog: File;
  182.  
  183. Begin  { Main Program }
  184.   assign(nextprog,progs[menu(maxlines,lines)]);
  185.   execute(nextprog)
  186. End.
  187.  
  188.